home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue25 / hipsquar / BOWTIE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-06-07  |  3.3 KB  |  135 lines
  1. {*********************************************************}
  2. {                                                         }
  3. {     Creating Non-Rectangular Windows                    }
  4. {                                                         }
  5. {     Requires Win32 API (Delphi 2.0 or 3.0 or newer)     }
  6. {                                                         }
  7. {     Copyright ⌐ 1997 Steven J. Colagiovanni             }
  8. {                                                         }
  9. {*********************************************************}
  10.  
  11. unit bowtie;
  12.  
  13. interface
  14.  
  15. uses
  16.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  17.   ExtCtrls;
  18.  
  19. type
  20.   TfrmBowTie = class(TForm)
  21.     procedure FormCreate(Sender: TObject);
  22.     procedure FormKeyDown(Sender: TObject; var Key: Word;
  23.       Shift: TShiftState);
  24.     procedure FormPaint(Sender: TObject);
  25.   private
  26.         { Private declarations }
  27.         procedure WMNCHitTest(Var Msg: TMessage); message WM_NCHITTEST;
  28.     public
  29.         { Public declarations }
  30.     end;
  31.  
  32. var
  33.     frmBowTie: TfrmBowTie;
  34.  
  35. implementation
  36.  
  37. {$R *.DFM}
  38.  
  39. var
  40.     RgnPts: array[0..11] of TPoint;        //Window region (outline)
  41.     PgnPts: array[0..11] of TPoint;        //Points for outlining region
  42.  
  43. Const
  44.     nPts: integer= 12;
  45.  
  46. procedure TfrmBowTie.WMNCHitTest(Var Msg: TMessage);
  47. begin
  48.     { Respond to left mouse button down, so we can drag window }
  49.     if GetAsyncKeyState(VK_LButton) < 0 then
  50.         Msg.Result := HTCaption
  51.     else
  52.         Msg.Result := HTClient;
  53.  
  54.     { if right mouse button down, close window }
  55.     if GetAsyncKeyState(VK_RButton) < 0 then
  56.         Close;
  57. end;
  58.  
  59. procedure CalcRgnPoints;
  60. begin
  61.     { Set points of polygon for window border }
  62.     RgnPts[0] := Point(30, 12);
  63.     RgnPts[1] := Point(125, 12);
  64.     RgnPts[2] := Point(125, 0);
  65.     RgnPts[3] := Point(250, 0);
  66.  
  67.     RgnPts[4] := Point(250, 12);
  68.     RgnPts[5] := Point(375, 12);
  69.     RgnPts[6] := Point(345, 81);
  70.     RgnPts[7] := Point(250, 81);
  71.  
  72.     RgnPts[8] := Point(250, 93);
  73.     RgnPts[9] := Point(125, 93);
  74.     RgnPts[10] := Point(125, 81);
  75.     RgnPts[11] := Point(0, 81);
  76.  
  77.  
  78.     { ============================= }
  79.  
  80.     { Set points of polygon for painting window border }
  81.     // Polygon must fit within the window boundaries
  82.     // Reduce all polygon points by one
  83.     PgnPts[0] := Point(31, 13);
  84.     PgnPts[1] := Point(126, 13);
  85.     PgnPts[2] := Point(126, 1);
  86.     PgnPts[3] := Point(249, 1);
  87.  
  88.     PgnPts[4] := Point(249, 13);
  89.     PgnPts[5] := Point(374, 13);
  90.     PgnPts[6] := Point(344, 80);
  91.     PgnPts[7] := Point(249, 80);
  92.  
  93.     PgnPts[8] := Point(249, 92);
  94.     PgnPts[9] := Point(126, 92);
  95.     PgnPts[10] := Point(126, 80);
  96.     PgnPts[11] := Point(1, 80);
  97.  
  98. end;
  99.  
  100. procedure TfrmBowTie.FormCreate(Sender: TObject);
  101. var
  102.     Region: hRgn;
  103.  
  104. begin
  105.     CalcRgnPoints;        //Construct polygon
  106.     { Create region, or window boundaries from the polygon }
  107.     Region := CreatePolygonRgn(RgnPts[0], nPts, ALTERNATE);
  108.     { Assign the region to the window }
  109.     SetWindowRgn(Handle, Region, True);
  110.  
  111.     { Do not delete region - Windows now has control
  112.         of the region. }
  113. end;
  114.  
  115. procedure TfrmBowTie.FormKeyDown(Sender: TObject; var Key: Word;
  116.     Shift: TShiftState);
  117. begin
  118.     if key = VK_Escape then Close;
  119. end;
  120.  
  121. procedure TfrmBowTie.FormPaint(Sender: TObject);
  122. begin
  123.     { Paint window border }
  124.     with canvas do
  125.     begin
  126.         Pen.Color := clBlack;
  127.         Pen.Width := 2;
  128.         Brush.Color := clRed;
  129.         Polygon(PgnPts);
  130.     end;
  131.  
  132. end;
  133.  
  134. end.
  135.